﻿Imports System.IO
Imports System.Runtime.InteropServices
Imports System.Security.Cryptography
Imports System.Text.RegularExpressions
Imports Microsoft.Office.Interop.Excel
Public Class Form1
    'excel 
    Public xlApp As New Application()

    ' 百家姓 字典
    Public dicX As New Dictionary(Of String, String)

    '输出路径
    'Public expFd As String = Directory.GetCurrentDirectory & "/exp/1/" & Format(Now, "yyyy-MM-dd hh_mm_ss")
    Public expFd As String
    'Public expFd As String = "D:\Desktop\exp\1" & "/exp/" & Format(Now, "yyyy-MM-dd hh_mm_ss")

    Public folderPath As String '= "D:\Desktop\exp\20230808_订-人行道的疯子\未处理U盘文件" ' 替换为你的文件夹路径

    Private ReadOnly maxThreads As Integer = 4 ' 最大线程数

    '保存处理情况
    Public dataRe As Object
    Public tRe&

    Public t0 As Date = Now
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

        folderPath = TbFdPath.Text
        expFd = Environment.GetFolderPath(Environment.SpecialFolder.Desktop) & "/exp/1/" & Format(Now, "yyyy-MM-dd hh_mm_ss")
        '创建输出路径
        Directory.CreateDirectory(expFd)
        '读取所有文件
        Dim fileList As New List(Of String)()
        SearchFiles(folderPath, fileList)

        Dim DeadTasks As New List(Of Task)()

        Dim dealCount As Long = 0

        Dim bt() As String = {"序号", "路径", "文件名", "状态", "备注", "表名", "输出路径"}
        ReDim dataRe(0 To 10 ^ 6, 0 To UBound(bt))
        dataRe(0, 0) = "处理目录"
        dataRe(0, 1) = folderPath
        tRe = 0


        tRe = 1
        For j As Integer = 0 To UBound(bt)
            dataRe(tRe, j) = bt(j)
        Next
        tRe = 2


        If fileList.Count > 0 Then
            '百家姓初始化
            DicXChh(dicX)

            ' 设置进度条
            ProgressBar.Minimum = 0
            ProgressBar.Maximum = fileList.Count
            ProgressBar.Value = 0
            ProgressBar.Step = 1

            '处理每一个文件
            For Each filePath As String In fileList


                ' 更新进度条
                ProgressBar.PerformStep()
                ' 展示进度 百分比
                dealCount += 1
                Me.LbJindu.Text = dealCount & "/" & fileList.Count & "(" & Microsoft.VisualBasic.Strings.Format(dealCount / fileList.Count, "0.00%") & ")"
                Me.LBTime.Text = (Now - t0).ToString
                System.Windows.Forms.Application.DoEvents()

                tRe += 1
                dataRe(tRe, 0) = dataRe(tRe - 1, 0) + 1
                dataRe(tRe, 1) = filePath
                dataRe(tRe, 2) = Path.GetFileName(filePath)
                '处理文件
                If Microsoft.VisualBasic.Left(Path.GetFileName(filePath), 1) <> "~" Then
                    Select Case Microsoft.VisualBasic.Left(UCase(Path.GetExtension(filePath)), 4)
                        Case ".XLS"
                            Call GetInfoFromWb(filePath)
                        Case ".TXT"
                            Call GetInfoFromWb(filePath)
                        Case Else

                            dataRe(tRe, 3) = "失败"
                            dataRe(tRe, 4) = "不支持格式"
                    End Select
                Else

                    dataRe(tRe, 3) = "失败"
                    dataRe(tRe, 4) = "~开头识别为隐藏配置文件,如果不是请修改文件名"
                End If


            Next

            Dim wbRe As Workbook = xlApp.Workbooks.Add
            Dim shtRe As Worksheet = wbRe.Sheets(1)
            With shtRe
                .Range("a1").Resize(tRe + 1, UBound(dataRe, 2) + 1).Value = dataRe
            End With
            wbRe.SaveAs(Filename:=expFd & "/res.xlsx")
            wbRe.Close(False)

        Else
            MsgBox("文件夹内没有文件!")
        End If
    End Sub

    ' 检索文件
    Sub SearchFiles(ByVal folderPath As String, ByRef fileList As List(Of String))
        Try
            Dim files As String() = Directory.GetFiles(folderPath)
            fileList.AddRange(files)

            Dim subFolders As String() = Directory.GetDirectories(folderPath)
            For Each subFolder As String In subFolders
                SearchFiles(subFolder, fileList)
            Next
        Catch ex As Exception
            Console.WriteLine("Error searching files: " & ex.Message)
        End Try
    End Sub

    ' 处理文件
    Function GetInfoFromWb(ByVal fname As String)
        GetInfoFromWb = False
        Try
            Dim wb As Workbook = xlApp.Workbooks.Open(fname, UpdateLinks:=0, Password:="")

            If wb Is Nothing Then
                ' 打开失败表示有密码
                ' 退出

                dataRe(tRe, 3) = "失败"
                dataRe(tRe, 4) = "未知错误"
                Exit Function
            Else
                dataRe(tRe, 3) = "成功"
            End If
            Dim expfname As String = expFd & "/" & Replace(Replace(wb.FullName, folderPath, ""), "\", "_")
            Dim sht As Worksheet
            For Each sht In wb.Sheets

                tRe += 1
                For j As Integer = 0 To 4
                    dataRe(tRe, j) = dataRe(tRe - 1, j)
                Next
                dataRe(tRe, 5) = sht.Name
                dataRe(tRe, 6) = GetInfoFromSht(sht, expfname)
                '对每一个表进行处理
                If Len(dataRe(tRe, 5)) > 0 Then
                    dataRe(tRe, 3) = "成功"
                Else
                    dataRe(tRe, 3) = "空表"
                End If
            Next

            wb.Close(SaveChanges:=False)

            Return expfname
            Exit Function
        Catch ex As Exception
            dataRe(tRe, 3) = "失败"
            dataRe(tRe, 4) = ex.Message
            If xlApp.Workbooks.Count > 0 Then
                For Each wb As Workbook In xlApp.Workbooks
                    wb.Close(False)
                Next
            End If
            Exit Function
        End Try

    End Function

    '处理工作表
    Function GetInfoFromSht(ByVal sht As Worksheet, ByVal fname As String)
        With sht
            Dim lr As Long = .Cells.SpecialCells(XlCellType.xlCellTypeLastCell).Row
            Dim lc As Long = .Cells.SpecialCells(XlCellType.xlCellTypeLastCell).Column
            '没有有效数值
            If lr = 1 Then

                Return 0
                Exit Function
            Else

            End If

            Dim data As Object(,) = .Range("a1").Resize(lr, lc).Value
            Dim colName As Integer = 0 '姓名列
            Dim colTel As Integer = 0 '电话列

            Dim temp_k As String
            Dim strX As String
            Dim strXm As String
            Dim rowCount1 As Long = 0
            Dim rowCount2 As Long = 0

            Dim regList() As String

            Dim i&, j&, i2&

            '确认姓名列
            Dim rng As Range = .Cells.Find(What:="姓名", LookAt:=XlLookAt.xlPart, LookIn:=XlFindLookIn.xlValues)

            Dim dic As New Dictionary(Of String, String)()

            If rng IsNot Nothing Then
                colName = rng.Column
            Else
                For i = 1 To Math.Min(10, lr)
                    For j = 1 To lc

                        If Len(data(i, j)) > 0 Then
                            '姓
                            regList = RegInfo(data(i, j), "[一-龥]")
                            If regList(0) = True Then
                                temp_k = regList(1)
                            Else
                                temp_k = Microsoft.VisualBasic.Left(data(i, j), 1)
                            End If

                            If dicX.ContainsKey(temp_k) = True Then
                                rowCount1 = 0
                                rowCount2 = 0

                                For i2 = 1 To lr
                                    '姓名
                                    strXm = data(i2, j) & ""
                                    If Len(strXm) > 0 And IsNumeric(strXm) = False And IsDate(strXm) = False Then
                                        rowCount1 += 1
                                        If dic.ContainsKey(strXm) = False Then
                                            dic.Add(strXm, "")
                                        End If
                                    End If

                                    '姓
                                    strX = Microsoft.VisualBasic.Left(strXm, 1)
                                    If dicX.ContainsKey(strX) = True Then
                                        rowCount2 += 1
                                    End If

                                Next

                                '超过10个姓 或者 超过10个人名
                                If rowCount2 >= 5 Or dic.Count > 5 Then
                                    colName = j

                                    dic.Clear()
                                    i = 10
                                    j = lc
                                    Exit For
                                End If
                            End If
                        End If
                    Next
                Next
            End If



            '确认列是否有效
            Dim expStr As String = ""
            Dim regListName() As String
            Dim regListTel() As String


            Dim nfname As String = fname & "_" & sht.Name & ".csv"
            Using Wr1 As New StreamWriter(nfname)

                For i = 1 To lr
                    expStr = ""
                    If colName > 0 Then
                        regListName = RegInfo(data(i, colName) & "", "[一-龥]+")
                        If regListName(0) = True Then '有姓名
                            expStr = regListName(1)
                            For i2 = 2 To UBound(regListName)
                                expStr = expStr & ";" & regListName(i2)
                            Next

                        End If

                    End If

                    For j = 1 To lc
                        regListTel = RegInfo(data(i, j), "\d+")
                        If regListTel(0) = True Then
                            For i2 = 1 To UBound(regListTel)
                                If Len(regListTel(i2)) = 11 And Microsoft.VisualBasic.Left(regListTel(i2), 1) = "1" Then
                                    Wr1.WriteLine(regListTel(i2) & "," & expStr)

                                    strX = Microsoft.VisualBasic.Left(expStr, 1)
                                    If dicX.ContainsKey(strX) = False Then
                                        dicX.Add(strX, "")
                                    End If

                                End If
                            Next
                        End If
                    Next


                Next
            End Using

            Return nfname
            Exit Function


        End With
    End Function
    '百家姓初始化
    Shared Sub DicXChh(ByRef dic As Dictionary(Of String, String))

        Dim xm() As String = {"赵", "钱", "孙", "李", "周", "吴", "郑", "王", "冯", "陈", "褚", "卫", "蒋", "沈", "韩", "杨", "朱", "秦", "尤", "许", "何", "吕", "施", "张", "孔", "曹", "严", "华", "金", "魏", "陶", "姜", "戚", "谢", "邹", "喻", "柏", "水", "窦", "章", "云", "苏", "潘", "葛", "奚", "范", "彭", "郎", "鲁", "韦", "昌", "马", "苗", "凤", "花", "方", "俞", "任", "袁", "柳", "酆", "鲍", "史", "唐", "费", "廉", "岑", "薛", "雷", "贺", "倪", "汤", "滕", "殷", "罗", "毕", "郝", "邬", "安", "常", "乐", "于", "时", "傅", "皮", "卞", "齐", "康", "伍", "余", "元", "卜", "顾", "孟", "平", "黄", "和", "穆", "萧", "尹", "姚", "邵", "湛", "汪", "祁", "毛", "禹", "狄", "米", "贝", "明", "臧", "计", "伏", "成", "戴", "谈", "宋", "茅", "庞", "熊", "纪", "舒", "屈", "项", "祝", "董", "梁", "杜", "阮", "蓝", "闵", "席", "季", "麻", "强", "贾", "路", "娄", "危", "江", "童", "颜", "郭", "梅", "盛", "林", "刁", "钟", "徐", "邱", "骆", "高", "夏", "蔡", "田", "樊", "胡", "凌", "霍", "虞", "万", "支", "柯", "昝", "管", "卢", "莫", "经", "房", "裘", "缪", "干", "解", "应", "宗", "丁", "宣", "贲", "邓", "郁", "单", "杭", "洪", "包", "诸", "左", "石", "崔", "吉", "钮", "龚", "程", "嵇", "邢", "滑", "裴", "陆", "荣", "翁", "荀", "羊", "於", "惠", "甄", "曲", "家", "封", "芮", "羿", "储", "靳", "汲", "邴", "糜", "松", "井", "段", "富", "巫", "乌", "焦", "巴", "弓", "牧", "隗", "山", "谷", "车", "侯", "宓", "蓬", "全", "郗", "班", "仰", "秋", "仲", "伊", "宫", "宁", "仇", "栾", "暴", "甘", "钭", "厉", "戎", "祖", "武", "符", "刘", "景", "詹", "束", "龙", "叶", "幸", "司", "韶", "郜", "黎", "蓟", "薄", "印", "宿", "白", "怀", "蒲", "邰", "从", "鄂", "索", "咸", "籍", "赖", "卓", "蔺", "屠", "蒙", "池", "乔", "阴", "胥", "能", "苍", "双", "闻", "莘", "党", "翟", "谭", "贡", "劳", "逄", "姬", "申", "扶", "堵", "冉", "宰", "郦", "雍", "郤", "璩", "桑", "桂", "濮", "牛", "寿", "通", "边", "扈", "燕", "冀", "郏", "浦", "尚", "农", "温", "别", "庄", "晏", "柴", "瞿", "阎", "充", "慕", "连", "茹", "习", "宦", "艾", "鱼", "容", "向", "古", "易", "慎", "戈", "廖", "庾", "终", "暨", "居", "衡", "步", "都", "耿", "满", "弘", "匡", "国", "文", "寇", "广", "禄", "阙", "东", "欧", "殳", "沃", "利", "蔚", "越", "夔", "隆", "师", "巩", "厍", "聂", "晁", "勾", "敖", "融", "冷", "訾", "辛", "阚", "那", "简", "饶", "空", "曾", "毋", "沙", "乜", "养", "鞠", "须", "丰", "巢", "关", "蒯", "相", "查", "後", "荆", "红", "游", "竺", "权", "逯", "盖", "益", "桓", "公", "万俟", "司马", "上官", "欧阳", "夏侯", "诸葛", "闻人", "东方", "赫连", "皇甫", "尉迟", "公羊", "澹台", "公冶", "宗政", "濮阳", "淳于", "单于", "太叔", "申屠", "公孙", "仲孙", "轩辕", "令狐", "钟离", "宇文", "长孙", "慕容", "鲜于", "闾丘", "司徒", "司空", "亓官", "司寇", "仉", "督", "子车", "颛孙", "端木", "巫马", "公西", "漆雕", "乐正", "壤驷", "公良", "拓跋", "夹谷", "宰父", "谷梁", "晋", "楚", "闫", "法", "汝", "鄢", "涂", "钦", "段干", "百里", "东郭", "南门", "呼延", "归", "海", "羊舌", "微生", "岳", "帅", "缑", "亢", "况", "后", "有", "琴", "梁丘", "左丘", "东门", "西门", "商", "牟", "佘", "佴", "伯", "赏", "南宫", "墨", "哈", "谯", "笪", "年", "爱", "阳", "佟", "第五", "言", "福"}
        Dim i As Integer
        For i = LBound(xm) To UBound(xm)
            If dic.ContainsKey(xm(i)) = False Then
                dic.Add(xm(i), 0)
            End If
        Next
    End Sub
    '正则
    Shared Function RegInfo(ByVal str As String, ByVal regStr As String)
        Dim dataRe() As String
        If Len(str) = 0 Then
            ReDim dataRe(0)
            dataRe(0) = False
            Return dataRe
            Exit Function
        End If

        Dim reg As New Regex(regStr)
        Dim matches As MatchCollection = reg.Matches(str)

        ReDim dataRe(matches.Count)
        If UBound(dataRe) > 0 Then
            dataRe(0) = True
            Dim i As Integer = 0
            For Each match As Match In matches
                i += 1
                dataRe(i) = match.Value
            Next
        Else
            dataRe(0) = False
        End If

        Return dataRe
    End Function

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
        'xlApp.Visible = True
    End Sub

    Private Sub Form1_Closed(sender As Object, e As EventArgs) Handles Me.Closed
        xlApp.Quit()
    End Sub
End Class
